HPAVC/HPAVC CD-ROM.iso/pc/ML_VECTB.ZIP/SOURCE/VECTBALL.PAS

Pascal/Delphi Source File | 1996-05-04 | 17.1 KB | 715 lines

{

   3D Vector Balls
   by Maple Leaf, 1996
   version 1.2 (update 3: 4th May 1996, -> system timer support added + speedups)
   -----------------------------------------------------------------------
   Using XMODE v1.1 and ENGINE3D v3.0, both (C)Copywrong by Maple Leaf.
   -----------------------------------------------------------------------
   No comments are necessarry. Theoretically, the program's running speed
   depends only on the video card's speed. Conclusion: buy a video accelerator! :)
   Leaving the jokes away, the 3D engine works very fast for such a small
   number of points (48), and xImageOvr routine (from XMODE 1.1) has
   been optimized for speed (by me!:), so there shouldn't be speed problems
   in running this shitty program. If there are some, well, blame your
   computer; I THINK it's not my fault...

}
uses engine3d, xmode, dosio, crt;

const
  Forms      = 8;
  MaxHeights = 256;
  { Limits }
  MaxRadius  = 150;
  MaxH       = 100;

  PagMin:byte= 0;
  PagMax:byte= 3;

type
  BallType = array [0..10] of record
                                x,y  : integer;
                                data : array [byte] of byte;
                              end;
  FormType = record
               dots : integer;
               data : array [0..47] of record x,y,z:integer end;
             end;

var
  putLogo : boolean;
  Ball  : array [0..2] of BallType;
  Form  : array [0..Forms-1] of FormType;
  pal   : array [byte] of record r,g,b:byte end;
  origpal : array [byte] of record r,g,b:byte end;
  capag, cvpag, cball : integer;
  TiltStep, RotStep : Integer;
  CFormModel : FormType; { Model for form-transforming }
  CForm : FormType;      { Current form }
  CFormNr : Integer;
  CPoints : array [0..50] of record
                              x     : integer;
                              y     : integer;
                              Zdist : longint;   { 8 bytes }
                            end;
  FCounter : word;
  {}
  Y_Val  : array [0..MaxHeights-1] of Integer;  { Heights }
  YIndex : array [0..47] of Integer;  { Y index }
  YSpd   : array [0..47] of Integer;  { * Y variation speed }
  Rad    : array [0..47] of Integer;  { Radius for each trajectory }
  RadSpd : array [0..47] of Integer;  { * Radius variation speed }
  Ang    : array [0..47] of Integer;  { Angle for each trajectory }
  AngSpd : array [0..47] of Integer;  { * Angle variation speed }
  {}
  ML_BitMap : array [0..2999] of byte; {3 Kb}

  old_int8 : pointer;
  intr : array [byte] of pointer absolute 0:0;

const
  Angles : array [0..Forms-1] of record RotA, TiltA : integer end = (
                                                                (RotA:2;TiltA:3),
                                                                (RotA:2;TiltA:3),
                                                                (RotA:-1;TiltA:3),
                                                                (RotA:2;TiltA:1),
                                                                (RotA:-2;TiltA:3),
                                                                (RotA:-3;TiltA:2),
                                                                (RotA:3;TiltA:1),
                                                                (RotA:-2;TiltA:1)
                                                              );

  BallCol : array [0..Forms-1] of word = ( 0, 0, 0, 0, 0, 0, 0, 0 );

Procedure LoadData;
var f:file;
begin
  Writeln('Loading data ...');
  { red ball }
  openforinput(f,'data\redball.tab','');
  blockread(f,Ball[0],260*11);
  closefile(f,'');
  { blue ball }
  openforinput(f,'data\blueball.tab','');
  blockread(f,Ball[1],260*11);
  closefile(f,'');
  { green ball }
  openforinput(f,'data\grnball.tab','');
  blockread(f,Ball[2],260*11);
  closefile(f,'');
  { form #1 }
  openforinput(f,'data\_init.bal','');
  blockread(f,Form[0],290);
  closefile(f,'');
  { form #2 }
  openforinput(f,'data\_sphere.bal','');
  blockread(f,Form[1],290);
  closefile(f,'');
  { form #3 }
  openforinput(f,'data\_cube.bal','');
  blockread(f,Form[2],290);
  closefile(f,'');
  { form #4 }
  openforinput(f,'data\_jupiter.bal','');
  blockread(f,Form[3],290);
  closefile(f,'');
  { form #5 }
  openforinput(f,'data\_2blobs.bal','');
  blockread(f,Form[4],290);
  closefile(f,'');
  { form #6 }
  openforinput(f,'data\_triangl.bal','');
  blockread(f,Form[5],290);
  closefile(f,'');
  { form #7 }
  openforinput(f,'data\_pyram.bal','');
  blockread(f,Form[6],290);
  closefile(f,'');
  { form #8 }
  openforinput(f,'data\_cross.bal','');
  blockread(f,Form[7],290);
  closefile(f,'');
  { palette }
  openforinput(f,'data\balls.pal','');
  blockread(f,pal,768);
  move(pal,origpal,768);
  closefile(f,'');
  { ML bitmap }
  openforinput(f,'data\ml.btm','');
  blockread(f,ML_BitMap,93*31+4);
  closefile(f,'');
end;

procedure Shit(s:string);
var k,p:byte;
const col:array[0..6] of byte = ( 8, 1, 3, 9, 11, 15, 7 );
begin
  for k:=1 to length(s) do begin
    for p:=0 to 6 do begin
      textattr:=col[p];
      write(s[k],#8);
      delay(15);
    end;
    write(s[k]);
  end;
  writeln;
end;

Procedure DoneAll;
begin
  Shit('   ──--∙ by Maple Leaf, 1996 ∙-───');
  Shit(' *  Hope you''ve enjoyed this shit  *');
end;

Procedure UpdateForm1;near;assembler;
asm
  inc FCounter
  cmp FCounter,350
  jb @Slide
  { First, update the form's index }
  inc CFormNr
  cmp CFormNr,Forms-1
  jbe @Ok1
  mov CFormNr,0
@Ok1:
  { Update the angles variation speed }
  mov si,CFormNr
  shl si,2
  mov ax,word ptr Angles[si]    {Rot}
  mov bx,word ptr Angles[si+2]  {Tilt}
  mov RotStep,ax
  mov TiltStep,bx
  shr si,1
  mov ax,word ptr BallCol[si]
  mov CBall,ax
  { Update form model }
  mov ax,ds
  mov es,ax
  mov si,CFormNr
  shl si,1
  mov ax,si    { ax:=cformnr*2 }
  shl si,4
  add ax,si    { ax:=cformnr*2+cformnr*32 }
  shl si,3
  add si,ax    { si:=cformnr*2+cformnr*32+cformnr*256 = cformnr*290 }
  add si,offset Form {!}
  mov di,offset CFormModel
  mov cx,145 {290/2}
  rep movsw
  { Reset counter }
  mov FCounter,0
  jmp @Outta
@Slide:
  { Slide to the form shown by CFormModel }
  mov si,offset CForm + 2
  mov di,offset CFormModel + 2
  mov cx,48
@Loop1:
    {X}
    mov ax,[si]
    cmp ax,[di]
    je @Next1
    jl @Less1
    dec ax
    mov [si],ax
    jmp @Next1
  @Less1:
    inc ax
    mov [si],ax
  @Next1:
    {Y}
    mov ax,[si+2]
    cmp ax,[di+2]
    je @Next2
    jl @Less2
    dec ax
    mov [si+2],ax
    jmp @Next2
  @Less2:
    inc ax
    mov [si+2],ax
  @Next2:
    {Z}
    mov ax,[si+4]
    cmp ax,[di+4]
    je @Next3
    jl @Less3
    dec ax
    mov [si+4],ax
    jmp @Next3
  @Less3:
    inc ax
    mov [si+4],ax
  @Next3:
    add di,6  { Next coordinates }
    add si,6  { -"- }
  loop @Loop1
@Outta:
end;

procedure FastSort;near;assembler;  { "Fast" enough for such an application... }
asm
  push bp
  mov si,4 + offset CPoints
  mov cx,47
@Loop1:
    mov bp,cx               { save counter }
    mov di,si
    add di,8                { second value pointer }
    @Loop2:
      db 66h; mov ax,[di]   { load second Z distance }
      db 66h; cmp ax,[si]
      jle @Nothing
      { Swap Z distances }
      db 66h; mov bx,[si]
      db 66h; mov [si],ax
      db 66h; mov [di],bx
      { Swap X coords }
      mov ax,[si-4]
      mov bx,[di-4]
      mov [si-4],bx
      mov [di-4],ax
      { Swap Y coords }
      mov ax,[si-2]
      mov bx,[di-2]
      mov [si-2],bx
      mov [di-2],ax
     {}
    @Nothing:
      add di,8
    loop @Loop2
@NoLoop:
    mov cx,bp          { restore counter }
    add si,8           { advance value pointer }
  loop @Loop1          { loop it 47 times }
  pop bp
end;

var i,dist,xx,yy:integer; yes:boolean;

procedure Display;near;  { Displays the sorted balls }
begin
  if PutLogo then ximageput(@ml_bitmap,227,169,capag);
  for i:=0 to 47 do begin
    asm
      mov si,i
      shl si,3
      mov ax,word ptr CPoints[si+4]
      sub ax,270
      sar ax,4
      cmp ax,10
      jle @Ok1
      mov ax,10
      jmp @Ok2
    @Ok1:
      test ax,ax
      jge @Ok2
      xor ax,ax
    @Ok2:
      mov dist,ax
      mov ax,word ptr Cpoints[si]
      mov word ptr xx,ax
      mov ax,word ptr Cpoints[si+2]
      mov word ptr yy,ax
      {}
      mov yes,1
      cmp xx,0
      jl @NoWay
      cmp yy,0
      jl @NoWay
      cmp xx,303
      jg @NoWay
      jmp @Yeah
    @NoWay:
      mov yes,0
    @Yeah:
    end;
    if yes then ximageovr(@ball[cball][dist],xx,yy,capag);{}
    {xvplot(xx,yy,100,capag);{}
  end;
end;

Procedure DrawForm;near;assembler;
asm
    { Clear active page }
    push capag
    call xclrvpage
    { 3D to 2D mapping }
    mov si,offset CForm+2
    mov ax,ds
    mov es,ax
    mov di,offset CPoints
    mov cx,48
@1: {X}
    db 66h, 0Fh, 0BFh, 04h {movsx eax,word ptr [si]}
    add si,2
    db 66h; mov word ptr _3dx,ax
    {Y}
    db 66h, 0Fh, 0BFh, 04h {movsx eax,word ptr [si]}
    add si,2
    db 66h; mov word ptr _3dy,ax
    {Z}
    db 66h, 0Fh, 0BFh, 04h {movsx eax,word ptr [si]}
    add si,2
    db 66h; mov word ptr _3dz,ax
    {}
    db 66h; push cx
    push si; push di
    call IntMapCoordinates         { Do mapping }
    pop di; pop si
    db 66h; pop cx
    mov ax,word ptr _2dx; stosw    { Store 2DX }
    mov ax,word ptr _2dy; stosw    { Store 2DY }
    db 66h; mov ax,word ptr Zt
    db 66h; stosw  {stosd}         { Store Z distance }
    dec cx
    jnz @1
    { Sort coordinates by Z distance }
    call FastSort
    { Display }
    call Display
end;

procedure FadeOut;near;assembler;  { Quick slides the palette to white }
asm
  push bp
  mov cx,64
  @Loop1:
    mov bp,cx  { Save counter }
    { "Increment" RGB fields }
    mov cx,768
    mov si,offset pal
    mov di,si
    @Loop2:
      lodsb
      inc al
      cmp al,63
      jbe @Ok1
      mov al,63
    @Ok1:
      stosb
    loop @Loop2
    { Wait for some horizontal retraces }
    mov cx,1 { 4 times = 4 scan lines }
    @Loop6:
      mov dx,3dah
      @Loop3:
        in al,dx
        test al,1
      jne @Loop3
      @Loop4:
        in al,dx
        test al,1
      je @Loop4
    loop @Loop6
    { Set new palette }
    mov cx,256
    mov si,offset pal
    mov dx,3c8h
    mov ah,0
    @Loop5:
       mov al,ah
       out dx,al
       inc dx
       outsb
       outsb
       outsb
       dec dx
       inc ah
    loop @Loop5
    mov cx,bp  { Restore counter }
  loop @Loop1  { Loop it 64 times }
  pop bp
end;

procedure FadeIn;near;assembler;  { Quick slides the palette from white to normal }
asm
  push bp
  mov cx,64
  @Loop1:
    mov bp,cx  { Save counter }
    { "Decrement" RGB fields }
    mov cx,768
    mov si,offset pal
    mov di,offset origpal
    @Loop2:
      mov al,[si]
      mov ah,[di]
      cmp al,ah
      je @Ok1
      dec al
      mov [si],al
    @Ok1:
      inc si
      inc di
    loop @Loop2
    { Wait for vertical retrace }
    mov dx,3dah
    mov cx,128
    @Loop6:
      @Loop3:
        in al,dx
        test al,1
      jne @Loop3
      @Loop4:
        in al,dx
        test al,1
      je @Loop4
    loop @Loop6
    { Set new palette }
    mov cx,256
    mov si,offset pal
    mov dx,3c8h
    mov ah,0
    @Loop5:
       mov al,ah
       out dx,al
       inc dx
       outsb
       outsb
       outsb
       dec dx
       inc ah
    loop @Loop5
    mov cx,bp  { Restore counter }
  loop @Loop1  { Loop it 64 times }
  pop bp
end;

var fc:word;

procedure accelerate;near;
const freq = 70; {?}
begin
  port[$43]:=$36;
  port[$40]:=lo($1234dc div freq);
  port[$40]:=hi($1234dc div freq);
end;

procedure unaccelerate;near;
begin
  port[$43]:=$36;
  port[$40]:=$ff;
  port[$40]:=$ff;
end;

procedure my8_part1;interrupt;
begin
  asm
    cli
    db 66h; pusha
    push es
  end;
  IncrAngle(RotAngle,RotStep);             { Increment angles of rotation }
  IncrAngle(TiltAngle,TiltStep);
  UpdateForm1;                             { Update current form (fine slides) }
  inc(fc);
  asm
    pop es
    mov al,20h
    out 20h,al
    db 66h; popa
    sti
  end;
end;

procedure DoPart1;near;     { **** PART ONE **** }
begin
  { Init pages }
  capag:=pagmin;
  cvpag:=pagmax;
  { Init angles' speeds }
  RotStep:=2;
  TiltStep:=3;
  { Init form }
  cformnr:=0;
  Fcounter:=320;
  fc:=0;
  cball:=0;
  move(form[cformnr],cformModel,sizeof(formtype));
  move(form[cformnr],cform,sizeof(formtype));
  old_int8:=intr[8];
  accelerate;
  intr[8]:=@my8_part1;
  repeat
    xvwait;                                  { Wait for vertical retrace }
    xsetvpage(cvpag);                        { Set visual page }
    DrawForm;                                { Draw form }
    inc(capag); if capag>pagmax then capag:=pagmin;    { Advance pages }
    inc(cvpag); if cvpag>pagmax then cvpag:=pagmin;
  until keypressed or (fc>=2450+150);
  if keypressed then readkey;
  FadeOut;
  intr[8]:=old_int8;
  unaccelerate;
end;

Procedure UpdateForm2;near;assembler;
asm
  mov cx,48
  xor si,si
  mov di,offset CForm + 2
  @Loop1:
    push cx {save counter}
    { Increment Y index (using its speed) }
    mov ax,word ptr YSpd[si]
    mov bx,word ptr YIndex[si]
    add bx,ax
    cmp bx,MaxHeights-1
    jle @Ok1
    sub bx,bx
  @Ok1:
    mov word ptr YIndex[si],bx  { Update index }
    { Extract height }
    add bx,bx
    mov ax,word ptr Y_Val[bx]
    mov [di+2],ax  { Set Y }
    { Increment radius (using its speed) }
    mov ax,word ptr RadSpd[si]
    mov bx,word ptr Rad[si]
    add bx,ax
    jge @Ok2
    mov bx,0
  @Ok2:
    mov word ptr Rad[si],bx  { Update radius }
    { Increment angle (using its speed) }
    mov ax,word ptr AngSpd[si]
    mov bx,word ptr Ang[si]
    add bx,ax
    jge @Ok4
    add bx,360
    jmp @Ok5
  @Ok4:
    cmp bx,359
    jle @Ok5
    sub bx,360
  @Ok5:
    mov word ptr Ang[si],bx  { Update angle }
    { Compute X and Z coordinates }
    shl bx,2
    { X:=radius*cos(angle) }
    db 66h; mov cx,word ptr CosTab[bx]
    mov ax,word ptr Rad[si]
    db 66h; cbw {cwde}
    db 66h; imul cx
    db 66h; sar ax,8 {Normalize}
    mov [di],ax   { Set X coordinate }
    { Z:=radius*sin(angle) }
    db 66h; mov cx,word ptr SinTab[bx]
    mov ax,word ptr Rad[si]
    db 66h; cbw {cwde}
    db 66h; imul cx
    db 66h; sar ax,8 {Normalize}
    mov [di+4],ax { Set Z coordinate }
    { Update indexes }
    add si,2
    add di,6
    pop cx
  dec cx
  jnz @Loop1
end;

var kk:word;

procedure my8_part2;interrupt;
begin
  asm
    cli
    db 66h; pusha
    push es
  end;
  UpdateForm2;                             { Update current form (fine slides) }
  IncrAngle(RotAngle,RotStep);             { Increment angles of rotation }
  IncrAngle(TiltAngle,TiltStep);
  inc(FCounter);
  if FCounter=300 then begin
    for kk:=0 to 47 do repeat AngSpd[kk]:=Random(5) until AngSpd[kk]<>0;
    FCounter:=301;
  end;
  if (FCounter>=900) and (FCounter<900+MaxH) then begin
    for kk:=0 to MaxHeights-1 do if Y_Val[kk]>0 then dec(Y_Val[kk]);
    if ObserverY<0 then inc(ObserverY);
  end;
  if (FCounter=1050+MaxH) then RotStep:=1;
  if (FCounter=1650+MaxH) then
    for kk:=0 to 47 do RadSpd[kk]:=-1;
  asm
    pop es
    mov al,20h
    out 20h,al
    db 66h; popa
    sti
  end;
end;

procedure DoPart2;near;  { **** PART TWO **** }
var k:integer;
begin
  xclrvram;
  for capag:=pagmin to pagmax do if PutLogo then ximageput(@ml_bitmap,227,169,capag);
  FadeIn;
  { Init }
  capag:=pagmin;
  cvpag:=pagmax;
  SetAngles(0,110);
  SetObserverPosition(0,40,300);
  fillchar(Yindex,48*2,0);
  fillchar(Ang,48*2,0);
  fillchar(Rad,48*2,0);
  for k:=0 to MaxHeights-1 do
    Y_Val[k]:=Trunc(MaxH*sin(pi*k/MaxHeights));
  randomize;
  for k:=0 to 47 do begin
    repeat YSpd[k]:=Random(5) until YSpd[k]>0;
    rad[k]:=random(maxradius-40) + 40;
    yindex[k]:=random(maxheights);
    ang[k]:=random(360);
  end;
  cball:=1;
  FCounter:=0;
  RotStep:=0;
  TiltStep:=0;
  old_int8:=intr[8];
  accelerate;
  intr[8]:=@my8_part2;
  repeat
    xvwait;                                  { Wait for vertical retrace }
    xsetvpage(cvpag);                        { Set visual page }
    DrawForm;                                { Draw form }
    inc(capag); if capag>pagmax then capag:=pagmin;    { Advance pages }
    inc(cvpag); if cvpag>pagmax then cvpag:=pagmin;
  until keypressed or (FCounter>=1650+MaxH+MaxRadius+50);
  if keypressed then readkey;
  FadeOut;
  intr[8]:=old_int8;
  unaccelerate;
end;

begin
  LoadData;
  If AskMessage('Do you want to permanently see the ML logo ? (lower speed if Yes)') then
    PutLogo:=true
  else
    PutLogo:=false;

  xinitvideo(0); pagmax:=3; {320x200/256/4pag}
  xclrvram;
  xsetpalette(@pal);

  { Init 3D engine }
  Perspective:=True;
  ZoomFactor:=250;
  SetObserverPosition(0,0,300);
  SetCamera(0,0,0);
  SetAngles(0,0);

  DoPart1;   { Do the first part }
  DoPart2;   { Do the second part }

  xclrvram;
  FadeIn;

  xtextmode(25);
  DoneAll;
end.